perm filename DRAW.F4[DRW,LCS]5 blob
sn#502487 filedate 1980-03-25 generic text, type T, neo UTF8
00100 C***** FOLLOWING IS FILE 'DRAW.CMD' **********
00200 C*** DRAW[DRW,LCS],MSSIO[MS,LCS],CB[DRW,LCS]
00300 C*** ,DRAWSM[DRW,LCS],DPYIT[DRW,LCS],DREDIT[DRW,LCS],FILLER[DRW,LCS]
00400 C*** ,CURSOR[MSS,LCS],SUBSLM[DRW,LCS]
00500
00600 C 'G' OR <CR> = GET. 'A'=ADD TO COMBINED FILE.
00700 C P=PLOT
00800 C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
00900 C F=JUMP AND BEGIN FILL SECTION. FX=EXIT AND FILL ALL.
01000 C SINGLE ITEM IS RESTRICTED TO 350 WDS. 10 ITEMS OR 350 WDS PER FILE.
01100 C 'O' MAKES CURRENT DPY INTO OVERLAY.
01200
01300 C VECTORS ARE PACKED 1 TO A WORD IN THE FOLLOWING STRANGE MANNER:
01400 C ABCDEFGHI REPRESENTS A 9-DIGIT NUMBER.
01500 C A=0=VISIBLE VECT., A=1=INVISIBLE, A=2=INVIS. AND START OF FILLED AREA.
01600 C BCDE=THE X COORDINATE, B=0=POSITIVE, B=1=NEG. (THE RANGE IS + OR - 999)
01700 C FGHI=THE Y COORDINATE, F=0=POSITIVE, F=1=NEG. (THE RANGE IS + OR - 999)
01800 C THUS 100671025 MEANS INVIS. VECTOR TO X=67, Y=-25.
01900
02000 COMMON /SAV/JCLEF(10),KCLEF(10),NMLST(10) /INCR/INCR
02100 CIRC COMMON /RC/MCLEF(400)
02200 COMMON /RC/MCLEF(400),IST(4000)
02300 1 /GRID/GRID
02400 CIRC 1 /DPY/NDP,IOV,GRID
02500 C NDP=BUFFER NUM FOR OUTPUT, IOV=BUFFER NUM FOR INPUT
02600 DIMENSION JST(450),INP(72),V(30)
02700 COMMON/ZN/SCLEF(2,400),DDD /ED/KED,NEXT,NN,NX,NY,J
02800 COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
02900 COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,RJB,CENTR
03000 CIRC COMMON/LETS/LETS(14) /FL/IC,N,NQ,RZ
03100 CIRC DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
03200 CIRC 1'O','L','W','H'/, ISIZE/2000/, RJB/-20./,CENTR/-26./
03300 COMMON/LETS/LETS(15) /FL/IC,N,NQ,RZ
03400 DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
03500 1'O','L','W','H','Q'/, ISIZE/2000/, RJB/-20./,CENTR/-26./
03600 EQUIVALENCE (MM,SCLEF(1,1)),(V2,V(2)),(V3,V(3)),(N,INP),
03700 1 (IVI,V1,V),(LETS(13),LW),(LETS(14),LH),(JC,INP(2)),(JS,
03800 1 INP(3)),(LETS(1),LG),(LETS(2),LS),(LETS(3),LM),(LETS(4)
03900 1,LD),(LETS(5),LR),(LETS(6),LP),(LETS(7),LA),(LETS(8),LF)
04000 1,(LETS(9),LE),(LETS(10),LZ),(LETS(11),LO),(LETS(12),LLL)
04100 1,(IST2,IST(2))
04200 CIRC CALL ERRSET(0)
04300 CIRC CALL DPYSET(ISIZE,1)
04400 CIRC NDP=1
04500 CIRC IOV=1
04600 RSZ=0
04700 GRID=0
04800 39 MCLEF(1)=0
04900 CIRC CALL DPYCLR
05000 CIRC CALL DPYOUT(NDP)
05100 CALL DPYSET(1,IST,4000)
05200 CALL HYDPOG(1)
05300 C IF AN OVERLAY HAS BEEN SETUP IT SHOULD STILL DISPLAY AFTER DPYCLR.
05400 C THIS IS FOR 'Z' (ZERO THE DRAWING)
05500 C DPYSET INITIALIZES GRAPHICS PACKAGE AND EXPANDS CORE FOR BUFFER.
05600 MM=0
05700 K=1
05800 17 FORMAT(' *',$)
05900 18 FORMAT(' H=HELP')
06000 TYPE 18
06100 91 TYPE 17
06200 55 FORMAT(I,2F)
06300 50 FORMAT(72A1)
06400 500 XSZ=RSZ
06500 ACCEPT 50,INP
06600 CALL RREAD(INP,V)
06700 C V ARRAY HAS ZEROS IF ALPHAS IN INP ARRAY.
06800 RSZ=V2
06900 GRID=V3
07000 51 IF(RSZ.EQ.0)RSZ=XSZ
07100 C TO SAVE SIZE FACTOR WHEN REDRAWING.
07200 MORE=-1
07300 CALL LO2UP(N)
07400 CALL LO2UP(JC)
07500 CALL LO2UP(JS)
07600 IF(RSZ.EQ.0)RSZ=9.0
07700 IF(GRID.NE.0.AND.N.NE.LP)CALL GRIDS
07800 CIRC DO 191 K=1,14
07900 DO 191 K=1,15
08000 C G S M D R P A F E Z
08100 191 IF(LETS(K).EQ.N)GO TO(30,36,32,33,32,70,36,79,38,39,
08200 1 56,11,12,16,32)K
08300 C O L W H Q
08400 IF(N.NE.' ')TYPE 391
08500 GO TO 91
08600 391 FORMAT(' UNKNOWN COMMAND'/)
08700 C 'O' MAKES CURRENT DPY INTO OVERLAY
08800
08900 16 TYPE 100
09000 C 'HELP'
09100 GO TO 91
09200
09300 11 CALL LIST(0)
09400 C TYPE OUT LIST OF COORDINATES.
09500 GO TO 91
09600
09700 12 TYPE 41
09800 C WRITE LIST OF COORDS ON DISK FILE
09900 CALL A5IN(JC)
10000 IF(N.NE.LW)GO TO 13
10100 CALL LIST(JC)
10200 GO TO 91
10300
10400 CIRC13 OPEN(UNIT=1,FILE=JC)
10500 13 CALL IFILE (1,JC)
10600 14 READ(1,5,END=15)N,JC,JS,JZ
10700 C READ IN EDIT FILE OF COORDS. N, X, Y, Z (N IS COUNT NUMB.)
10800 JZ=JZ*100000000
10900 C JZ=1=INVIS =2=START FILLER (INVIS)
11000 CALL REPACK(JC,JS,JZ,MCLEF(N+1))
11100 GO TO 14
11200 15 MCLEF(1)=N+1
11300 CIRC CALL DPYCLR
11400 IST2=0
11500 CALL DPYSET(1,IST,4000)
11600 GO TO 334
11700
11800 33 IF(JS.NE.LLL)GO TO 38
11900 N=LZ
12000 C DEL=DELETE FROM COMB. FILE. (JS=LLL)
12100 GO TO 36
12200 38 KED=N
12300 MM=MCLEF(1)
12400 IF(MM.NE.0)GO TO 92
12500 C ADD TO DRAWING?
12600 GO TO 3
12700
12800 CIRC56 CALL DPYSET(400,2)
12900 56 CALL POG2
13000 C INITIALIZE THE OVERLAY
13100 CIRC IOV=2
13200 CIRC NDP=2
13300 CIRC CALL RDRAW(2,MCLEF(1),MCLEF)
13400 CALL RDRAW(3,2,MCLEF(1),MCLEF)
13500 CIRC IOV=1
13600 CIRC CALL DPYOUT(NDP)
13700 C SAVE OVERLAY IN SPECIAL MEMORY
13800 GO TO 91
13900 36 CALL CMBN
14000 GO TO 91
14100 32 IF(JC.EQ.LE)GO TO 12
14200 C RE=READ EDIT FILE FOR VECTORS
14300 CALL DPYSET(1,IST,4000)
14400 IST2=0
14500 CALL SHIFT(MCLEF(2),MCLEF(1),N)
14600 C FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
14700 J=1
14800 JC=0
14900 GO TO 333
15000 291 FORMAT(A2,A5)
15100 30 REREAD 291,NM,NM
15200 CALL LO2UP(NM)
15300 IF(JC.EQ.LM)NM=' '
15400 IF(NM.NE.' ')GO TO 293
15500 130 TYPE 41
15600 IF(JC.EQ.LM)GO TO 194
15700 IF(N.EQ.LS)GO TO 194
15800 C 'GET' REINIT VARIOUS THINGS
15900 MCLEF(1)=0
16000 MM=0
16100 K=1
16200 194 IF(JC.EQ.LM)MORE=0
16300 JQ=JC
16400 JC=0
16500 JM=1
16600 IF(MCLEF(1).EQ.0)GO TO 193
16700 JM=MCLEF(1)+1
16800 193 CALL A5IN(NM)
16900 IF(NM.EQ.' ')NM=LASTNM
17000 IF(NM.EQ.' ')GO TO 91
17100 IF(NM.EQ.'B'.OR.NM.EQ.'99')GO TO 91
17200 C 'B' OR '99' WILL BACKUP
17300 293 LASTNM=NM
17400 IF(LOOKF(NM).EQ.0)GO TO 130
17500 C 'FAIL' ROUTINE TO CHECK ON LOOKUP 0=FILE NOT FOUND.
17600 CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
17700 C -1=READ
17800 J=1
17900 IF(KCLEF(2).EQ.0)GO TO 290
18000 TYPE 1100
18100 ACCEPT 55,J
18200 J=J+1
18300 C ITEMS ARE NUMBERED 0 THROUGH 9 (10 ITEMS).
18400 IF(J.GT.10)GO TO 191
18500 290 IC=KCLEF(J)+JST(KCLEF(J))-1
18600 IF(IC.GT.350)TYPE 1110
18700 60 JZ=1
18800 IF(MORE.EQ.0)JZ=JM
18900 L=KCLEF(J)-1
19000 M=JST(L+1)+JZ-1
19100 IF(MORE.NE.0)GO TO 161
19200 M=M-1
19300 L=L+1
19400 161 DO 61 K=JZ,M
19500 L=L+1
19600 61 MCLEF(K)=JST(L)
19700 MCLEF(1)=M
19800 1100 FORMAT(' ITEM NUM?'/)
19900 7 IF(MORE)GO TO 70
20000 DO 771 K=2,JM-1
20100 771 IF(MCLEF(K).GE.200000000)GO TO 772
20200 GO TO 70
20300 C PUTS FILLER TO END
20400 C MOVES OUTLINE UP FRONT
20500 772 M=MCLEF(1)
20600 DO 773 L=K,JM
20700 M=M+1
20800 773 MCLEF(M)=MCLEF(L)
20900 K=JM-K
21000 1774 DO 774 L=JM,M
21100 774 MCLEF(L-K)=MCLEF(L)
21200 CALL DPYSET(1,IST,4000)
21300 IST2=0
21400 GO TO 3
21500
21600 70 IF(N.NE.LP)GO TO 3
21700 CIRC OPEN(UNIT=1,FILE='PLOT.PLT',MODE='IMAGE')
21800 CIRC CALL SAVBUF(1)
21900 C WRITES VERSATEC FILE PLOT.PLT
22000 CIRC CLOSE(UNIT=1)
22100 CIRC TYPE 441
22200 CIRC GO TO 91
22300 CIRC441 FORMAT(' ******* PLOT.PLT WAS WRITTEN *****')
22400
22500 3 IF(N.NE.LD)MM=0
22600 C RESET IF NOT GOING TO DRAWIT
22700 333 IF(N.EQ.LP)GO TO 337
22800 CC CALL DPYCLR
22900 IF(N.GE.0)GO TO 337
23000 IF(N.EQ.LG)GO TO 337
23100 IF(N.EQ.LM)GO TO 337
23200 IF(N.NE.LR)GO TO 92
23300 337 IF(JS.EQ.LZ)GO TO 306
23400 IF(JS.NE.LS)GO TO 338
23500 CALL SMOOTH(JS)
23600 GO TO 436
23700 338 IC=-1
23800 MM=1
23900 DO 335 K=2,MCLEF(1)
24000 IF(MCLEF(K).LT.200000000)GO TO 335
24100 IC=K
24200 GO TO 334
24300 C FOR 1ST LOC. OF MCLEF IN FILLER
24400 335 CONTINUE
24500 CIRC334 CALL RDRAW(2,MCLEF(1),MCLEF)
24600 334 CALL RDRAW(1,2,MCLEF(1),MCLEF)
24700 C 1=DPYOUT(1)
24800 CIRC CALL DPYOUT(NDP)
24900 GO TO 91
25000 79 IF(IC.LT.0)GO TO 91
25100 C FILLS IT.
25200 C IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
25300 JZ=N
25400 KK=0
25500 IF(JC.NE.LS)GO TO 206
25600 C TYPE 'FS' TO FILL AND SMOOTH
25700 306 CALL SMOOTH(0)
25800 C SMOOTHS AND FILLS
25900 GO TO 436
26000 206 RR=RSZ
26100 DO 205 J=IC,MCLEF(1)
26200 CALL UNPACK(M,N,LL,MCLEF(J))
26300 KK=KK+1
26400 NF(KK)=0
26500 IF(LL.GE.100000000)NF(KK)=3
26600 QF(KK)=(M+RJB)*RR
26700 205 RF(KK)=(N+CENTR)*RR
26800 NF(1)=KK
26900 CALL FILLQ(QF,RF,NF)
27000 436 GO TO 91
27100
27200 5 FORMAT(12I)
27300 100 FORMAT(' G=GET, GM=GET MORE, S=SAVE, D=DRAW, M=MOVE, R=ROTATE,'/
27400 1' E=EDIT, P=PLOT, RE=READ EDIT FILE, W=WRITE EDIT FILE'/
27500 1' LI=LIST COORDINATES'/
27600 1,' DEL=DELETE ITEM FROM FILE, O=OVERLAY, Z=ZERO DRAWING'/,
27700 1' F=FILL N1=IMAGE SIZE, N2=1=GRID -1=DELETE OVERLAY'/)
27800 C N1=20 TO CHANGE SHAPE
27900
28000 CIRC92 CALL DPYCLR
28100 C92 CALL HYDPOG(1)
28200 92 CALL DPYSET(1,IST,4000)
28300 CIRC CALL RDRAW(2,MCLEF(1),MCLEF)
28400 CALL RDRAW(1,2,MCLEF(1),MCLEF)
28500 C THIS CLEARS FILLER LINES
28600 CALL DRAWIT
28700 N=0
28800 GO TO 3
28900
29000 403 FORMAT(' WRITE OVER ',A5,'.DMD? ',$)
29100 41 FORMAT(' TYPE FILE NAME'/)
29200 110 FORMAT(' TOTAL WDS=',I3)
29300 1110 FORMAT(' ********************************',/
29400 1 ' ***** WARNING - LIMIT=350 ******',/
29500 1 ' ********************************')
29600 END